home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 4 / BBS in a Box - Macintosh - Volume IV (January 1992) (BBS in a Box).iso / Files / Prog / S / STAR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-10-17  |  3.5 KB  |  96 lines  |  [TEXT/MACA]
  1. Program Star;
  2.  
  3. {
  4.     A Graphic printing example,
  5.     draws a filled pentagram on the screen and the printer.
  6.     This works with any output device as long as the user set
  7.     up the appropriate driver with the Chooser DA.
  8.  
  9.     Algorithm:
  10.         Move to the starting point.
  11.         Start defining polygon.
  12.             set radians to 0
  13.             Draw a horizontal line Dist long.
  14.             Do 4 times.
  15.                 Rotate right 144°
  16.                 Draw a  line Dist long.
  17.         end polygon definition
  18.         Set up printer port
  19.         Draw polygon again
  20.         Print it.
  21.         Close Printer Port.
  22. }
  23.  
  24. USES  Memtypes,QuickDraw,OSIntf,ToolIntf, MacPrint;
  25.  
  26. const
  27.     Dist        = 150;
  28.     ScalePat    = 35;
  29.  
  30. var
  31.     theline     : integer;
  32.     radians,
  33.     x, y        : real;
  34.     StarPoly    : PolyHandle;
  35.     Scales      : Pattern;
  36.     prRecHdl    : THPrint;
  37.     result      : boolean;
  38.     thePrPort   : TPPrPort;
  39.     prStatus    : TPrStatus;
  40.  
  41. procedure Rotate(var theta : real; r : real);
  42. {   rotates a nuber of radians }
  43.  
  44. Procedure PolarToRect(theta, length : real; var x, y : real);
  45. {   Polar to rectangulal coordinate converter. }
  46.  
  47. begin   { PolarToRect }
  48.     x := Sin(theta) * length;
  49.     y := Cos(theta) * length
  50. end;    { of PolarToRect }
  51.  
  52. begin   { Rotate }
  53.     theta := theta + 1.2 * Pi;
  54.     PolarToRect(radians,Dist,x,y);
  55. end;    { of Rotate }
  56.  
  57. begin   { Star }
  58.     MoveTo(500,100);        { Move to the starting point. }
  59.     radians := 0;           { set radians to 0 }
  60.     StarPoly := OpenPoly;   { Start polygon definition. }
  61.     Line(-dist, 0);         { Draw a horizontal line Dist long. }
  62.     For theline := 1 to 4 do
  63.         begin
  64.             Rotate(radians,Dist);       { Rotate 144° }
  65.             Line(Trunc(y), Trunc(-x));  { Draw the line }
  66.         end;
  67.     ClosePoly;              { End polygon definition. }
  68.     GetIndPattern(Scales, sysPatListID, ScalePat);  { Get the fish scale pattern }
  69.     FillPoly(StarPoly,Scales);          { Fill the points of the pentagram }
  70.     readln;
  71.     PrOpen;                             { Open the printer driver }
  72.     prRecHdl := THPrint(NewHandle(SizeOf(TPrint)));     { Allocate space for print style record }
  73.     PrintDefault(prRecHdl);             { Set style to defaults for the driver }
  74.     result := PrStlDialog(prRecHdl);    { This is usually the response to "Page Setup..." }
  75.     if PrJobDialog(prRecHdl) then       { And this is the response to "Print." }
  76.         begin
  77.             thePrPort := PrOpenDoc(prRecHdl, NIL, NIL); { Once for each print job }
  78.             if PrError = NoErr then
  79.                 begin
  80.                     PrOpenPage(thePrPort, NIL);         { Call once for each page. }
  81.                     if PrError = NoErr then
  82.                         FillPoly(StarPoly,Scales);      { Draw into the printing grafPort }
  83.                     PrClosePage(thePrPort)              { Finished with the page }
  84.                 end;
  85.             PrCloseDoc(thePrPort);                      { Finished with the job }
  86.  
  87. {   The next line handles the spooling from the disk if the user chose anything but draft printing.
  88.     If this were a big program I would 'UnloadSeg' everything but the blank segment and the printing
  89.     segment before calling this. }
  90.             if (prRecHdl^^.prJob.BJDocLoop = bSpoolLoop) and (PrError = NoErr) then
  91.                 PrPicFile(prRecHdl,NIL,NIL,NIL,prStatus);
  92.             if PrError <> NoErr then
  93.                 write(' Printer error code ', PrError)
  94.         end;
  95.     PrClose     { We're finished with the printer driver. }
  96. end.    { of Star }